home
***
CD-ROM
|
disk
|
FTP
|
other
***
search
/
Magnum One
/
Magnum One (Mid-American Digital) (Disc Manufacturing).iso
/
d26
/
matrxinv.arc
/
GJELIM.BAS
next >
Wrap
BASIC Source File
|
1986-12-08
|
5KB
|
216 lines
REM SIMULTANEOUS SOLUTION WITH MULTIPLE CONSTANTS
REM BY GAUSS-JORDAN ELIMINATION
REM IDENTIFIERS
REM E1% ERMES% ERROR FLAG
REM I2% INDEX% WORK MATRIX
REM I5% INVFS% INVERSE FLAG
REM M1% MAX% MACIMUM LENGTH
REM N1% NROW% NUMBER OF ROWS
REM N2% NCOL% NUMBER OF COLUMNS
REM N3% NVEC% NUMBER OF CONSTANT VECTORS
REM END OF IDENTIFIERS
REM
DIM A(8,8),Z(8,8),W(8,8),B(8,8),I2%(8,3)
A$=" ##.####^^^^ "
B$=" = ##.###^^^^"
C$=" ##.#####"
M1%=8
REM
PRINT"SIMULTANEOUS SOLUTION BY GOUSS-JORDAN ELIMINATION"
120 GOSUB 500 : REM GET THE DATA
GOSUB 5000 : REM GOUSS-JORDAN SUBROUTINE
REM
IF (N1%>5) THEN 290
PRINT "THE INPUT MATRIX IS:";
IF (N3%>0) THEN PRINT " CONSTANSTS";
PRINT
FOR I%=1 TO N1%
FOR J%=1 TO N2%
PRINT USING A$;A(I%,J%);
NEXT J%
IF(N3%=0) THEN 270
FOR J%=1 TO N3% : REM CONSTANT VECTORS
PRINT USING B$;Z(I%,J%);
NEXT J%
270 PRINT
NEXT I%
290 PRINT
IF (E1%=1 OR N3%=0) THEN 400
PRINT" SOLUTION"
PRINT
FOR I%= 1 TO N2%
FOR J%=1 TO N3%
PRINT USING C$;W(I%,J%);
NEXT J%
PRINT
NEXT I%
PRINT
400 GOTO 120 : REM NEXT SET OF EQUATIONS
500 REM
REM INPUT THE DATA
REM
I5%=1
PRINT
550 INPUT" HOW MANY EQUATIONS ";N1%
IF (N1%>M1%) THEN 550
IF (N1%<2) THEN 9999
N2%=N1%
INPUT " HOW MANY CONSTANT VECTORS ";N3%
IF (N3%=0) THEN I5%=0 : REM PRINT INVERSE
FOR I%=1 TO N1%
PRINT "EQUATION ";I%
FOR J%=1 TO N2%
PRINT J%;" ";
INPUT A(I%,J%) : REM COEFFICIENTS
NEXT J%
IF (N3%<1) THEN 710
FOR J%=1 TO N3%
INPUT" C ";Z(I%,J%) : REM CONSTANT VECTOR
NEXT J%
710 NEXT I%
RETURN : REM FROM INPUT ROUTINE
5000 REM GAUSS-JORDAN MATRIX INVERSION AND SOLUTION
REM FOR MULTIPLE CONSTANT VECTORS
REM IDENTIFIERS
REM A A COEFFICIENT MATRIX
REM B B WORK MATRIX
REM B1 BIG LARGEST ELEMENT
REM D3 DETERM DETERMINANT
REM E1% ERMES% ERROR FLAG
REM H1 HOLD WORK VARIABLE
REM I2% INDEX% WORK MATRIX
REM I3% IROW% ROW INDEX
REM I4% ICOL% COLUMN INDEX
REM I5% INVRS% PRINT-INVERSE FLAG
REM N2% NCOL% NUMBER OF COLUMNS
REM N3% NVEC% NUMBER OF CONSTANT VECTORS
REM P1 PIVOT PIVOT INDEX
REM W W SOLUTION MATRIX
REM Z Z CONSTANT VECTOR
REM END OF IDENTIFIERS
REM
E1%=0 : REM BECOMES 1 FOR SINGULAR MATRIX
REM I5%=1 : REM PRINT INVERSE IF ZERO
REM
REM N3%=1
FOR I%=1 TO N2%
FOR J%=1 TO N2%
B(I%,J%)=A(I%,J%)
NEXT J%
FOR J%=1 TO N3%
W(I%,J%)=Z(I%,J%)
NEXT J%
I2%(I%,3)=0
NEXT I%
D3=1
FOR I%=1 TO N2%
REM
REM SEARCH FOR LARGEST (PIVOT) ELEMENT
REM
B1=0
FOR J%=1 TO N2%
IF (I2%(J%,3)=1) THEN 5390
FOR K%=1 TO N2%
IF (I2%(K%,3)>1) THEN 6130
IF (I2%(K%,3)=1) THEN 5380
IF (B1>=ABS(B(J%,K%))) THEN 5380
I3%=J%
I4%=K%
B1=ABS(B(J%,K%))
5380 NEXT K%
5390 NEXT J%
I2%(I4%,3)=I2%(I4%,3)+1
I2%(I%,1)=I3%
I2%(I%,2)=I4%
REM INTERCHANGE ROWS TO PUT PIVOT ON DIAGONAL
IF (I3%=I4%) THEN 5580
D3=-1*D3
FOR L%=1 TO N2%
H1=B(I3%,L%)
B(I3%,L%)=B(I4%,L%)
B(I4%,L%)=H1
NEXT L%
IF (N3%<1) THEN 5580
FOR L%=1 TO N3%
H1=W(I3%,L%)
W(I3%,L%)=W(I4%,L%)
W(I4%,L%)=H1
NEXT L%
5570 REM DIVIDE PIVOT ROW BY PIVOT ELEMENT
5580 P1=B(I4%,I4%)
D3=D3*P1
B(I4%,I4%)=1
FOR L%=1 TO N2%
B(I4%,L%)=B(I4%,L%)/P1
NEXT L%
IF (N3%<1) THEN 5700
FOR L%=1 TO N3%
W(I4%,L%)=W(I4%,L%)/P1
NEXT L%
5680 REM
5690 REM REDUCE NONPIVOT ROWS
5700 FOR L1%=1 TO N2%
IF (L1%=I4%) THEN 5810
T=B(L1%,I4%)
B(L1%,I4%)=0
FOR L%=1 TO N2%
B(L1%,L%)=B(L1%,L%)-B(I4%,L%)*T
NEXT L%
IF (N3%<1) THEN 5810
FOR L%=1 TO N3%
W(L1%,L%)=W(L1%,L%)-W(I4%,L%)*T
NEXT L%
5810 NEXT L1%
NEXT I%
5830 REM
5840 REM INTERCHANGE COLUMNS
5850 REM
FOR I% = 1 TO N2%
L%=N2%-I%+1
IF (I2%(L%,1)=I2%(L%,2)) THEN 5960
I3%=I2%(L%,1)
I4%=I2%(L%,2)
FOR K%=1 TO N2%
H1=B(K%,I3%)
B(K%,I3%)=B(K%,I4%)
B(K%,I4%)=H1
NEXT K%
5960 NEXT I%
5970 FOR K%=1 TO N2%
IF (I2%(K%,3)<>1) THEN 6130
5990 NEXT K%
E1%=0
IF (I5%=1) THEN 6150
PRINT
PRINT" THE INVERSE OF THE INPUT MATRIX IS:"
FOR I%=1 TO N2%
FOR J%=1 TO N2%
PRINT USING A$;B(I%,J%);
NEXT J%
6080 PRINT
6090 NEXT I%
6100 PRINT
6110 PRINT "THE DETERMINANT OF THE INPUT MATRIX = ";D3
PRINT
6120 RETURN : REM IF INVERSE IS PRINTED
6130 E1%=1
6140 PRINT"ERROR - MATRIX SINGULAR"
6150 RETURN : REM FROM GAUSS-JORDAN SUBROUTINE
9999 END